home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / run-length2014018172006.psc / VB Projects / Common / FileDlg2.cls next >
Text File  |  2006-08-05  |  10KB  |  307 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "OSDialog"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' OSDialog  FileDlg2.cls  Open Save Dialog
  15.  
  16. ' (Modified from vbAccelerator.com)
  17.  
  18. '  Use eg
  19. '  On Form1:=
  20.  
  21. '' For using OSDialog(FileDlg2.cls)
  22. '  Dim CommonDialog1 As New OSDialog
  23.  
  24. ' Examples:-
  25. '  LOAD
  26. '   Title$ = "Load a picture file"
  27. '   Filt$ = "Pics bmp,jpg,gif,ico,cur,wmf,emf|*.bmp;*.jpg;*.gif;*.ico;*.cur;*.wmf;*.emf"
  28. '   InDir$ = CurrPath$ 'Pathspec$
  29. '   CommonDialog1.ShowOpen FileSpec$, Title$, Filt$, InDir$, "", Me.hwnd
  30. '
  31. '  SAVE
  32. '   Title$ = "Save Mask as 2-color bmp"
  33. '   Filt$ = "Save bmp|*.bmp"
  34. '   InDir$ = CurrPath$ 'Pathspec$
  35. '   CommonDialog1.ShowSave FileSpec$, Title$, Filt$, InDir$, "", Me.hwnd
  36. '
  37. '   Len(FileSpec$)=0 for cancel
  38.  
  39. Option Explicit
  40.  
  41. Private Declare Function CommDlgExtendedError Lib "COMDLG32" () As Long
  42.  
  43. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
  44.     (ByVal lpString As String) As Long
  45.  
  46. Private Const MAX_PATH = 2048 ' To accomodate multi-select string
  47. Private Const MAX_FILE = 2048
  48. Private Const MULTIFILEOPENORD = 1537
  49.  
  50. Private Type OPENFILENAME
  51.     lStructSize As Long          ' UDT length
  52.     hWndOwner As Long            ' Owner
  53.     hInstance As Long            ' Ignored (used only by templates)
  54.     lpstrFilter As String        ' Filter
  55.     lpstrCustomFilter As String  ' Ignored
  56.     nMaxCustFilter As Long       ' Ignored
  57.     nFilterIndex As Long         ' FilterIndex
  58.     lpstrFile As String          ' FileName
  59.     nMaxFile As Long             ' Handled internally
  60.     lpstrFileTitle As String     ' FileTitle
  61.     nMaxFileTitle As Long        ' Handled internally
  62.     lpstrInitialDir As String    ' InitDir
  63.     lpstrTitle As String         ' Dialog Title
  64.     flags As Long                ' Flags
  65.     nFileOffset As Integer       ' Ignored
  66.     nFileExtension As Integer    ' Ignored
  67.     lpstrDefExt As String        ' DefaultExt
  68.     lCustData As Long            ' Ignored (needed for hooks)
  69.     lpfnHook As Long             ' Ignored
  70.     lpTemplateName As Long       ' Ignored
  71. End Type
  72.  
  73. Public Enum ENUMOpenFile
  74.     OFN_READONLY = &H1
  75.     OFN_OVERWRITEPROMPT = &H2
  76.     OFN_HIDEREADONLY = &H4
  77.     OFN_NOCHANGEDIR = &H8
  78.     OFN_SHOWHELP = &H10
  79.     OFN_ENABLEHOOK = &H20
  80.     OFN_ENABLETEMPLATE = &H40
  81.     OFN_ENABLETEMPLATEHANDLE = &H80
  82.     OFN_NOVALIDATE = &H100
  83.     OFN_ALLOWMULTISELECT = &H200
  84.     OFN_EXTENSIONDIFFERENT = &H400
  85.     OFN_PATHMUSTEXIST = &H800
  86.     OFN_FILEMUSTEXIST = &H1000
  87.     OFN_CREATEPROMPT = &H2000
  88.     OFN_SHAREAWARE = &H4000
  89.     OFN_NOREADONLYRETURN = &H8000&
  90.     OFN_NOTESTFILECREATE = &H10000
  91.     OFN_NONE2RKBUTTON = &H20000
  92.     OFN_NOLONGNAMES = &H40000
  93.     OFN_EXPLORER = &H80000
  94.     OFN_NODEREFERENCELINKS = &H100000
  95.     OFN_LONGNAMES = &H200000
  96. End Enum
  97.  
  98. Private Declare Function GetOpenFileName Lib "COMDLG32" Alias "GetOpenFileNameA" _
  99.     (File As OPENFILENAME) As Long
  100.  
  101. Private Declare Function GetSaveFileName Lib "COMDLG32" Alias "GetSaveFileNameA" _
  102.     (File As OPENFILENAME) As Long
  103.  
  104. Dim m_lExtendedError As Long
  105. Dim m_IsShowing      As Boolean
  106.  
  107. Public Directory As String
  108. Public LastFile As String
  109. Public FullFileSpec As String
  110. Public LastSaveFile As String
  111. Public LastOpenFile As String
  112. Public LastSaveDir As String
  113. Public LastOpenDir As String
  114. 'Public LastAccessDir As String
  115.  
  116. ' If parameter MultiSelect is True, dialog will be new style
  117.  
  118. Function ShowOpen(Optional FileName As String, _
  119.                   Optional DlgTitle As String, _
  120.                   Optional Filter As String = "All (*.*)| *.*", _
  121.                   Optional InitDir As String, _
  122.                   Optional DefaultExt As String = "", _
  123.                   Optional owner As Long = -1, _
  124.                   Optional MultiSelect As Boolean = False, _
  125.                   Optional lpTemplateName As Long = False, _
  126.                   Optional FileTitle As String, _
  127.                   Optional FileMustExist As Boolean = True, _
  128.                   Optional ReadOnly As Boolean = False, _
  129.                   Optional HideReadOnly As Boolean = False, _
  130.                   Optional FilterIndex As Long = 1, _
  131.                   Optional flags As Long = 0) As String
  132.  
  133. Dim typOpenFile As OPENFILENAME
  134. Dim S As String
  135. Dim ch As String
  136. Dim I As Integer
  137. Dim mResult
  138.  
  139. If m_IsShowing = True Then Exit Function
  140.  
  141. m_lExtendedError = 0
  142.  
  143. With typOpenFile
  144.     .lStructSize = Len(typOpenFile)
  145.  
  146.      ' Add in specific flags and strip out non-VB flags
  147.     .flags = (-FileMustExist * OFN_FILEMUSTEXIST) Or _
  148.          (-MultiSelect * OFN_ALLOWMULTISELECT) Or _
  149.          (-ReadOnly * OFN_READONLY) Or _
  150.          (-HideReadOnly * OFN_HIDEREADONLY) Or _
  151.          (.flags And CLng(Not (OFN_ENABLEHOOK Or OFN_ENABLETEMPLATE)))
  152.     If owner <> -1 Then .hWndOwner = owner
  153.     .flags = .flags Or OFN_EXPLORER
  154.     .lpstrInitialDir = InitDir
  155.     .lpstrDefExt = DefaultExt
  156.     .lpstrTitle = DlgTitle
  157.     .lpTemplateName = MULTIFILEOPENORD
  158.     
  159.     ' To make Windows-style filter, replace | and : with nulls
  160.     For I = 1 To Len(Filter)
  161.         ch = Mid$(Filter, I, 1)
  162.         If ch = "|" Or ch = ":" Then
  163.              S = S & vbNullChar
  164.         Else
  165.              S = S & ch
  166.         End If
  167.     Next
  168.  
  169.     ' Put double null at end
  170.     S = S & vbNullChar & vbNullChar
  171.     .lpstrFilter = S
  172.     .nFilterIndex = FilterIndex
  173.  
  174.     ' Pad file and file title buffers to maximum path
  175.     S = FileName & String$(MAX_PATH - Len(FileName), 0)
  176.     .lpstrFile = S
  177.     .nMaxFile = MAX_PATH
  178.     S = FileTitle & String$(MAX_FILE - Len(FileTitle), 0)
  179.     .lpstrFileTitle = S
  180.     .nMaxFileTitle = MAX_FILE
  181.  
  182.     m_IsShowing = True
  183.     mResult = GetOpenFileName(typOpenFile)
  184.     m_IsShowing = False
  185.     If mResult = 1 Then
  186.          ' Find terminating string of at least double vbNullChars ||
  187.          mResult = InStr(1, .lpstrFile, vbNullChar & vbNullChar)
  188.          If mResult = 0 Then
  189.             FileName$ = .lpstrFile
  190.          Else
  191.             ' Remove excess vbNullChars
  192.             FileName$ = Left$(.lpstrFile, mResult - 1)
  193.          End If
  194.         For I = Len(FileName) To 1 Step -1
  195.             ch = Mid$(FileName, I, 1)
  196.             If ch = "\" Then Exit For
  197.         Next
  198.         Directory = Left$(FileName, I)
  199.         LastOpenDir = Directory
  200.         LastOpenFile = Right$(FileName, Len(FileName) - I)
  201.         LastFile = LastOpenFile
  202.         FullFileSpec = FileName
  203.         InitDir = Directory
  204.         FileName = LastOpenFile
  205.     Else
  206.          FileName$ = vbNullString
  207.          If mResult <> 0 Then    ' 0 is Cancel, else extended error
  208.               m_lExtendedError = CommDlgExtendedError()
  209.          End If
  210.     End If
  211. End With
  212.     
  213. ShowOpen = FileName
  214. End Function
  215.  
  216.  
  217. Private Function StrZToStr(S As String) As String
  218.     StrZToStr = Left$(S, lstrlen(S))
  219. End Function
  220.  
  221. Function ShowSave(Optional FileName As String, _
  222.                   Optional DlgTitle As String, _
  223.                   Optional Filter As String = "All (*.*)| *.*", _
  224.                   Optional InitDir As String, _
  225.                   Optional DefaultExt As String, _
  226.                   Optional owner As Long = -1, _
  227.                   Optional FileTitle As String, _
  228.                   Optional OverWritePrompt As Boolean = True, _
  229.                   Optional FilterIndex As Long = 1, _
  230.                   Optional flags As Long) As String
  231.             
  232. Dim typOpenFile As OPENFILENAME
  233. Dim S As String
  234. Dim ch As String
  235. Dim I As Integer
  236. Dim mResult
  237.  
  238. If m_IsShowing = True Then Exit Function
  239.  
  240. m_lExtendedError = 0
  241.  
  242. With typOpenFile
  243.     .lStructSize = Len(typOpenFile)
  244.  
  245.     ' Add in specific flags and strip out non-VB flags
  246.     .flags = (-OverWritePrompt * OFN_OVERWRITEPROMPT) Or _
  247.      OFN_HIDEREADONLY Or _
  248.      (flags And CLng(Not (OFN_ENABLEHOOK Or OFN_ENABLETEMPLATE)))
  249.     If owner <> -1 Then .hWndOwner = owner
  250.     .lpstrInitialDir = InitDir
  251.     .lpstrDefExt = DefaultExt
  252.     .lpstrTitle = DlgTitle
  253.  
  254.     ' Make new filter with bars (|) replacing nulls
  255.     ' and double null at end
  256.     For I = 1 To Len(Filter)
  257.          ch = Mid$(Filter, I, 1)
  258.          If ch = "|" Or ch = ":" Then
  259.               S = S & vbNullChar
  260.          Else
  261.               S = S & ch
  262.          End If
  263.     Next
  264.     ' Put double null at end
  265.     S = S & vbNullChar & vbNullChar
  266.     .lpstrFilter = S
  267.     .nFilterIndex = FilterIndex
  268.  
  269.     ' Pad file and file title buffers to maximum path
  270.     S = FileName & String$(MAX_PATH - Len(FileName), 0)
  271.     .lpstrFile = S
  272.     .nMaxFile = MAX_PATH
  273.     S = FileTitle & String$(MAX_FILE - Len(FileTitle), 0)
  274.     .lpstrFileTitle = S
  275.     .nMaxFileTitle = MAX_FILE
  276.     ' All other fields zero
  277.  
  278.     m_IsShowing = True
  279.     mResult = GetSaveFileName(typOpenFile)
  280.     m_IsShowing = False
  281.     If mResult = 1 Then
  282.          FileName = StrZToStr(.lpstrFile)
  283.          '  If you initiate the variables,
  284.          '  you can return the value(s)
  285.          'FileTitle = StrZToStr(.lpstrFileTitle)
  286.         For I = Len(FileName) To 1 Step -1
  287.             ch = Mid$(FileName, I, 1)
  288.             If ch = "\" Then Exit For
  289.         Next
  290.         Directory = Left$(FileName, I)
  291.         LastSaveDir = Directory
  292.         LastSaveFile = Right$(FileName, Len(FileName) - I)
  293.         LastFile = LastSaveFile
  294.         FullFileSpec = FileName
  295.         InitDir = Directory
  296.         FileName = LastSaveFile
  297.     Else
  298.          FileName = vbNullString
  299.          If mResult <> 0 Then   ' 0 is Cancel, else extended error
  300.               m_lExtendedError = CommDlgExtendedError()
  301.          End If
  302.     End If
  303. End With
  304.     
  305. ShowSave = FileName
  306. End Function
  307.